home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 4 / Apprentice-Release4.iso / Languages / Caml Light 0.7 / examples / demonstr / asynt.ml next >
Encoding:
Text File  |  1995-06-01  |  2.5 KB  |  84 lines  |  [TEXT/MPS ]
  1. #open "prop";;
  2. #open "lexuniv";;
  3.  
  4. let rec lire_proposition f = proposition5 f
  5.  
  6. and proposition0 = function
  7.     [< 'Ident s >] -> Variable s
  8.   | [< 'MC "vrai" >] -> Vrai
  9.   | [< 'MC "faux" >] -> Faux
  10.   | [< 'MC "("; lire_proposition p; 'MC ")" >] -> p
  11.  
  12. and proposition1 = function
  13.     [< 'MC "non"; proposition0 p >] -> Non p
  14.   | [< proposition0 p >] -> p
  15.  
  16. and proposition2 = function
  17.     [< proposition1 p; (reste2 p) q >] -> q
  18. and reste2 p = function
  19.     [< 'MC "et"; proposition1 q; (reste2 (Et (p, q))) r >] -> r
  20.   | [<>] -> p
  21.  
  22. and proposition3 = function
  23.     [< proposition2 p; (reste3 p) q >] -> q
  24. and reste3 p = function
  25.     [< 'MC "ou"; proposition2 q; (reste3 (Ou (p, q))) r >] -> r
  26.   | [<>] -> p
  27.  
  28. and proposition4 = function
  29.     [< proposition3 p; (reste4 p) q >] -> q
  30. and reste4 p = function
  31.     [< 'MC "=>"; proposition3 q; (reste4 (Implique (p, q))) r >] -> r
  32.   | [<>] -> p
  33.  
  34. and proposition5 = function
  35.     [< proposition4 p; (reste5 p) q >] -> q
  36. and reste5 p = function
  37.     [< 'MC "<=>"; proposition4 q; (reste5 (Équivalent(p,q))) r >] -> r
  38.   | [<>] -> p;;
  39. let lire_opération lire_opérateur lire_base constructeur =
  40.   let rec lire_reste e1 = function
  41.     [< lire_opérateur _;
  42.        lire_base e2;
  43.        (lire_reste (constructeur (e1, e2))) e >] -> e
  44.   | [< >] -> e1 in
  45.  function [< lire_base e1; (lire_reste e1) e >] -> e;;
  46. let rec lire_proposition f = proposition5 f
  47.  
  48. and proposition0 = function
  49.     [< 'Ident s >] -> Variable s
  50.   | [< 'MC "vrai" >] -> Vrai
  51.   | [< 'MC "faux" >] -> Faux
  52.   | [< 'MC "("; lire_proposition p; 'MC ")" >] -> p
  53.  
  54. and proposition1 = function
  55.     [< 'MC "non"; proposition0 p >] -> Non p
  56.   | [< proposition0 p >] -> p
  57.  
  58. and proposition2 flux =
  59.     lire_opération (function [< 'MC "et" >] -> ())
  60.                    proposition1
  61.                    (function (p,q) -> Et (p,q))
  62.                    flux
  63. and proposition3 flux =
  64.     lire_opération (function [< 'MC "ou" >] -> ())
  65.                    proposition2
  66.                    (function (p,q) -> Ou (p,q))
  67.                    flux
  68. and proposition4 flux =
  69.     lire_opération (function [< 'MC "=>" >] -> ())
  70.                    proposition3
  71.                    (function (p,q) -> Implique (p,q))
  72.                    flux
  73. and proposition5 flux =
  74.     lire_opération (function [< 'MC "<=>" >] -> ())
  75.                    proposition4
  76.                    (function (p,q) -> Équivalent (p,q))
  77.                    flux;;
  78. let analyseur_lexical =
  79.     construire_analyseur
  80.      ["vrai"; "faux"; "("; ")"; "non"; "et"; "ou"; "=>"; "<=>"];;
  81.  
  82. let analyse_proposition chaîne =
  83.     lire_proposition (analyseur_lexical (stream_of_string chaîne));;
  84.